home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Info-Mac 1992 August
/
info-mac-1992.iso
/
Applications (app)
/
Image 1.44
/
Macros
/
Image Macros
< prev
next >
Wrap
Text File
|
1991-06-24
|
4KB
|
171 lines
{
This file contains contains example macros written in Image's
Pascal-like programming language. These macros will automatically
be loaded when Image is launched as long as this file is in the same folder
as Image, or in the System folder, and it has the name 'Image Macros'.
}
macro 'Measure [1]' begin Measure end;
macro 'Show Results [2]' begin ShowResults end;
macro 'Reset [3]' begin ResetCounters end;
macro 'Copy Results [4]' begin CopyResults end;
macro 'Start Capture [G]' begin StartCapturing end;
Macro 'Draw Arrow [A]'
{Draws an arrow based on the current straight line selection.}
var
size,angle,dx,dy,pi,theta:real;
x1,y1,x2,y2,LineWidth,width,height:integer;
begin
size:=12; {pixels}
angle:=20; {degrees}
pi:=3.14159;
GetLine(x1,y1,x2,y2,LineWidth);
if x1<0 then begin
PutMessage('Use the line tool(straight) to select a line first.');
exit;
end;
MoveTo(x1,y1);
LineTo(x2,y2);
KillRoi;
GetPicSize(width,height);
y1:=height-y1;
y2:=height-y2;
if LineWidth>1 then size:=size*LineWidth*0.5;
angle:=(angle/180)*pi;
dx:=x1-x2;
dy:=y1-y2;
if dx=0 then begin
if dy>=0 then theta:=pi/2 else theta:=3/2*pi
end else begin
theta:=arctan(dy/dx);
if dx<0 then theta:=theta+pi;
end;
moveto(x2,height-y2);
lineto(x2+size*cos(theta+angle),height-(y2+size*sin(theta+angle)));
moveto(x2,height-y2);
lineto(x2+size*cos(theta-angle),height-(y2+size*sin(theta-angle)));
end;
macro 'Print All';
{Use SetOption, which turns off halftoning, for better quality}
{(and faster) printing of binary pictures.}
var
i:integer;
begin
for i:=1 to nPics do begin
SelectPic(i);
{SetOption;}
Print;
end;
end;
macro 'Clear Outside'
{Erase region outside current selection to background color.}
begin
Copy;
SelectAll;
Clear;
RestoreRoi;
Paste;
KillRoi;
end;
macro 'Make Bas-relief'
begin
Duplicate('Bas-relief');
SelectAll;
{SetOption; Smooth;}
Copy;
MoveRoi(-1,-1); {Try MoveRoi(1,1) for a different effect.}
Paste;
Subtract;
EnhanceContrast;
ApplyLUT;
end;
macro '(-' begin end;
macro 'Make Step Function';
{Generates a grayscale step function within the current selection.}
var
left,top,width,height,nSteps,StepSize,i,x:integer;
value:real;
begin
GetRoi(left,top,Width,Height);
if width=0 then begin
PutMessage('This macro requires a rectangular selection.');
Exit;
end;
SaveState;
nSteps:=GetNumber('Number of steps',16);
value:=255;
StepSize:=width div nSteps;
x:=left;
for i:=1 to nSteps do begin
MakeRoi(x,top,StepSize,Height);
SetForeground(round(value));
fill;
x:=x+StepSize;
value:=value-256/nSteps;
end;
KillRoi;
RestoreState;
end;
macro 'Random Ovals';
var
PicWidth,PicHeight,hloc,vloc,width,height:real;
begin
SaveState;
SetPalette('Spectrum');
MakeNewWindow('Random Ovals');
GetPicSize(PicWidth,PicHeight);
repeat
hloc:=width*random;
vloc:=height*random;
width:=(PicWidth-hloc)*random;
height:=(PicHeight-vloc)*random;
MakeOvalRoi(hloc,vloc,width,height);
SetForeground(255*random);
fill;
until Button;
KillRoi;
RestoreState;
end;
macro 'Draw Ball';
var
width,height,n,i,color,diam,nSteps:integer;
begin
SaveState;
nSteps:=64;
SetPalette('Spectrum');
SetBackground(255); {Black}
MakeNewWindow('Ball');
GetPicSize(Width,Height);
if width>height
then diam:=height
else diam:=width;
color:=1;
MakeOvalRoi((width-diam)/2,(height-diam)/2,diam,diam);
for i:=1 to nSteps do begin
InsetRoi(round(diam/(3*nSteps)));
SetForeground(color);
fill;
color:=color+round(256/nSteps);
if color>254 then color:=254;
end;
KillRoi;
RestoreState;
end;